A complete plotting example

This example is inspired from the plot-gtk-ui package. Our goal will be to create an interface similar to the screenshot below.



In [1]:

    
{-# LANGUAGE OverloadedStrings #-}
import IHaskell.Display.Widgets

First, we create a common structure that will hold all the information required to create a plot. This has to be done first so that we can hook widget events to modify it. The plotting logic is implemented next for the same reason.



In [2]:

    
import Data.IORef
import Data.Monoid (mempty)
import Data.Text (Text)
import qualified Data.Map as M

data PlotInfo = PlotInfo {
    plotTitle :: String,
    plotTitleSize :: Double,
    xLabel :: String,
    xLabelSize :: Double,
    yLabel :: String,
    yLabelSize :: Double,
    showXGrid :: Bool,
    showYGrid :: Bool,
    xRange :: (Double, Double),
    yRange :: (Double, Double),
    sampling :: Double,
    functions :: M.Map String (Double -> Double)
  }

defaultPlotInfo = PlotInfo {
    plotTitle = mempty,
    plotTitleSize = 10,
    xLabel = mempty,
    xLabelSize = 10,
    yLabel = mempty,
    yLabelSize = 10,
    showXGrid = True,
    showYGrid = True,
    xRange = (-5, 5),
    yRange = (-5, 5),
    sampling = 50,
    functions = mempty
  }

Now, we implement the plotting logic. We also create an ImageWidget here, which will be used to display the plot.



In [3]:

    
import Data.IORef
import Graphics.Rendering.Chart.Easy hiding (tan)
import Graphics.Rendering.Chart.Backend.Cairo
import qualified Data.ByteString as B
import IHaskell.Display (base64)
import Control.Applicative ((<$>))

tempImgWidget <- mkImageWidget

setField tempImgWidget Width 400
setField tempImgWidget Height 400

plotState <- newIORef defaultPlotInfo

-- Update and redraw.
update :: (PlotInfo -> IO PlotInfo) -> IO ()
update modifier = readIORef plotState >>= modifier >>= writeIORef plotState >> redraw

redraw :: IO ()
redraw = readIORef plotState >>= mkPlot >>= setField tempImgWidget B64Value . base64

mkDset :: PlotInfo -> [(String, [(Double, Double)])]
mkDset info = let funcs = M.toList $ functions info
                  (xLow, xHigh) = xRange info
                  period = 1 / sampling info
                  xs = [xLow, xLow + period .. xHigh]
              in map (\(s, f) -> (s, zip xs $ map f xs)) funcs

axisSetter :: Bool -> Bool -> AxisData t -> AxisData t
axisSetter axis grid ad =
  ad { _axis_grid = if grid then _axis_grid ad else []
     , _axis_visibility = if axis
                          then AxisVisibility True True True
                          else AxisVisibility False False False
     }

mkPlot :: PlotInfo -> IO B.ByteString
mkPlot info = do
  let dset = mkDset info
      opts = def { _fo_size = (400, 400) }
  toFile opts ".chart" $ do
    layout_title .= plotTitle info
    layout_title_style . font_size .= plotTitleSize info
    layout_x_axis . laxis_title .= xLabel info
    layout_x_axis . laxis_title_style . font_size .= xLabelSize info
    layout_x_axis . laxis_generate .= scaledAxis def (xRange info)
    layout_x_axis . laxis_override .= if showXGrid info then id else axisGridHide
    layout_y_axis . laxis_title .= yLabel info
    layout_y_axis . laxis_title_style . font_size .= yLabelSize info
    layout_y_axis . laxis_generate .= scaledAxis def (yRange info)
    layout_y_axis . laxis_override .= if showYGrid info then id else axisGridHide

    mapM_ (\(s, ps) -> plot (line s [ps])) dset
  B.readFile ".chart"

All that's left now is to create an interface and hook widget events accordingly.

The first required element is a box, to create a vertical division between the plotting region and the input widgets.



In [4]:

    
divBox <- mkFlexBox
setField divBox Orientation HorizontalOrientation

-- Two parts: A FlexBox for the left part (plot + sliders) and an Accordion for the input elements.
plBox <- mkFlexBox
tlBox <- mkAccordion

-- Add the widgets to the main dividing box.
setField divBox Children [ChildWidget plBox, ChildWidget tlBox]

-- Make the orientation Vertical
setField plBox Orientation VerticalOrientation

Now we fill in the plotting area with:

A FlexBox to hold the sliders.
An ImageWidget to hold the plot.



In [5]:

    
slBox <- mkFlexBox

-- Reusing the image widget created before
let plImg = tempImgWidget

-- Sliders need to be laid out vertically.
setField slBox Orientation VerticalOrientation

-- Add widgets to the plotting region.
setField plBox Children [ChildWidget slBox, ChildWidget plImg]

Now, we fill the other half with the following:

Four FlexBox widgets (title, sub-title, x-label, y-label), containing a TextWidget for title and a BoundedFloatText for the font size.
A FlexBox with two selection widgets for toggling visibility for different elements. We'll go with ToggleButton just for fun.
Two more FlexBox, with FloatText widgets for deciding the plot range.



In [6]:

    
-- The four FlexBox widgets.
import Control.Monad (replicateM, forM_)
import Data.List (zip4)
import Text.Printf (printf)
import Data.Text (unpack, pack)

-- pl : plotTitle
-- x : xLabel
-- y : yLabel
boxes <- replicateM 3 mkFlexBox
texts@[plTxt,xTxt,yTxt] <- replicateM 3 mkTextWidget
inpts@[plInp,xInp,yInp] <- replicateM 3 mkBoundedFloatText

-- Adding event handlers for text widgets. This is a clumsy way to emulate first-class record fields.
let setHandler widget field = setField widget ChangeHandler $ update $ \info -> do
      newStr <- getField widget StringValue
      return $ field info newStr
 in do
   setHandler plTxt $ \struct val -> struct { plotTitle = unpack val }
   setHandler xTxt $ \struct val -> struct { xLabel = unpack val }
   setHandler yTxt $ \struct val -> struct { yLabel = unpack val }

-- Adding events for the numeric input widgets.
let setHandler widget field = setField widget ChangeHandler $ update $ \info -> do
      newNum <- getField widget FloatValue
      return $ field info newNum
 in do
   setHandler plInp $ \struct val -> struct { plotTitleSize = val }
   setHandler xInp $ \struct val -> struct { xLabelSize = val }
   setHandler yInp $ \struct val -> struct { yLabelSize = val }

let boxInfo = zip4 boxes texts inpts ["plot title", "X-Label", "Y-Label"]

forM_ boxInfo $ \(box,text,input,placeholder) -> do
  setField box Orientation HorizontalOrientation
  setField box Children [ChildWidget text, ChildWidget input]
  setField text Placeholder $ pack $ printf "Enter %s here ..." placeholder
  setField input MinFloat 1
  setField input MaxFloat 72
  setField input FloatValue 10



In [7]:

    
-- A FlexBox with ToggleButtons
buttonBox <- mkFlexBox
setField buttonBox Orientation HorizontalOrientation
tButtons@[xGrid,yGrid] <- replicateM 2 mkToggleButton

let tgButtonInfo = zip tButtons ["X-Grid", "Y-Grid"]

let setHandler widget fieldSetter = setField widget ChangeHandler $ update $ \info -> do
      newStr <- getField widget BoolValue
      return $ fieldSetter info newStr
 in do
   setHandler xGrid $ \struct val -> struct { showXGrid = val }
   setHandler yGrid $ \struct val -> struct { showYGrid = val }

forM_ tgButtonInfo $ \(widget, description) -> do
  setField widget Description description
  setField widget BoolValue True

setField buttonBox Children (map ChildWidget tButtons)



In [8]:

    
import Control.Arrow (first, second)

-- Finally, the ranges
rangeBoxes <- replicateM 2 mkFlexBox
fTxts@[xLow,xHigh,yLow,yHigh] <- replicateM 4 mkFloatText

let rangeInfo = zip rangeBoxes [(xLow,xHigh), (yLow, yHigh)]

forM_ rangeInfo $ \(box, (lowTxt, highTxt)) -> do
  setField box Orientation HorizontalOrientation
  setField box Children (map ChildWidget [lowTxt, highTxt])

let setHandler widget modifier = setField widget ChangeHandler $ update $ \info -> do
      val <- getField widget FloatValue
      return $ modifier val info
 in do
   setHandler xLow $ \v p -> p { xRange = first (const v) (xRange p) }
   setHandler xHigh $ \v p -> p { xRange = second (const v) (xRange p) }
   setHandler yLow $ \v p -> p { yRange = first (const v) (yRange p) }
   setHandler yHigh $ \v p -> p { yRange = second (const v) (yRange p) }

Now, to finally add these widgets to the right part of the window.



In [9]:

    
setField tlBox Children $ map ChildWidget $ boxes ++ [buttonBox] ++ rangeBoxes

We also need to give a title to each page in the Accordion widget.



In [10]:

    
setField tlBox Titles ["Plot title", "X-Label", "Y-Label", "Grid", "X-range", "Y-range"]

Then we sync the initial values from the plotData to the widgets.



In [11]:

    
let syncVal widget value fieldGetter = readIORef plotState >>= setField widget value . fieldGetter
 in do
   syncVal plTxt StringValue (pack . plotTitle)
   syncVal plInp FloatValue plotTitleSize

   syncVal xTxt StringValue (pack . xLabel)
   syncVal xInp FloatValue xLabelSize
   syncVal yTxt StringValue (pack . yLabel)
   syncVal yInp FloatValue yLabelSize

   syncVal xGrid BoolValue showXGrid
   syncVal yGrid BoolValue showYGrid

   syncVal xLow FloatValue (fst . xRange)
   syncVal xHigh FloatValue (snd . xRange)
   syncVal yLow FloatValue (fst . yRange)
   syncVal yHigh FloatValue (snd . yRange)

Now that everything is set, we also need to provide a way for the user to add or remove plots from the interface.



In [12]:

    
addFunction :: String -> (Double -> Double) -> IO ()
addFunction name func = update $ \p -> return p { functions = M.insert name func $ functions p }

removeFunction :: String -> IO ()
removeFunction name = update $ \p -> return p { functions = M.delete name $ functions p }

And now we display the complete interface, ready to use.



In [13]:

    
-- Spurious update to display empty plot instead of empty image initially
update return

divBox

Now, we can use addFunction and removeFunction to add and remove functions respectively.



In [14]:

    
addFunction "sin" sin



In [15]:

    
addFunction "cos" cos



In [16]:

    
addFunction "x^2" (\x -> x * x)